#input<-read_lines("Day18Sample.txt")
input<-read_lines("../../AoCData/AOC2018/Day18.txt")
### Matrix
landscape<-matrix(0,nrow=length(input)+2,ncol=nchar(input[1])+2)

lsc<-lapply(input,function(x){
x<-unlist(str_split(x,""))
x[which(x==".")]<-"0"
x[which(x=="|")]<-"1"
x[which(x=="#")]<-"10"
x<-as.numeric(x)})

for(i in 1:length(lsc)){landscape[i+1,]<-c(0,unlist(lsc[[i]]),0)}

Part 1

forestgrow<-function(lsc,reps){
  r<-1
  while(r<=reps){
    nextforest<-matrix(NA,ncol=ncol(lsc),nrow=nrow(lsc))
    nextforest[1,]<-0
    nextforest[nrow(nextforest),]<-0
    nextforest[,1]<-0
    nextforest[,ncol(nextforest)]<-0
    for(i in 2:(nrow(lsc)-1)){
      for(j in 2:(ncol(lsc)-1)){
        nine<-sum(lsc[(i-1):(i+1),(j-1):(j+1)])
        switch(as.character(lsc[i,j]),
               "0"={if(nine%%10>=3){nextforest[i,j]<-1}else{nextforest[i,j]<-0}},
               "1"={if(nine>30){nextforest[i,j]<-10}else{nextforest[i,j]<-1}},
               "10"={if(nine%%10>=1&nine>=20){nextforest[i,j]<-10}else{nextforest[i,j]<-0}},
               cat("something is wrong\n"))
                #cat(i,j,lsc[i,j], nine,nextforest[i,j],"\n")
                }}
    lsc<-nextforest
    r<-r+1}
  trees<-length(which(lsc==1))
  lumberyards<-length(which(lsc==10))
  resources<-trees*lumberyards
  list(trees,lumberyards,resources,lsc)}
p1<-forestgrow(landscape,10)
part1<-p1[[3]]
part1
[1] 678529

Part 2

Depends heavily on the data, the real data has the pattern below Start by graphing to see if there’s a pattern for something that looks like a pattern -

forestgrowanimation<-function(lsc,reps){
  r<-1
  anim<-as.data.frame(matrix(ncol=4,nrow=0))
  cel<-melt(lsc)
  cel<-cbind(cel,rep(0,nrow(cel)))
  names(cel)<-c("y","x","resources","minutes")
  anim<-rbind(anim,cel)
  names(cel)<-c("y","x","resources","minutes")

  while(r<=reps){
    nextforest<-matrix(NA,ncol=ncol(lsc),nrow=nrow(lsc))
    nextforest[1,]<-0
    nextforest[nrow(nextforest),]<-0
    nextforest[,1]<-0
    nextforest[,ncol(nextforest)]<-0
    for(i in 2:(nrow(lsc)-1)){
      for(j in 2:(ncol(lsc)-1)){
        nine<-sum(lsc[(i-1):(i+1),(j-1):(j+1)])
        switch(as.character(lsc[i,j]),
               "0"={if(nine%%10>=3){nextforest[i,j]<-1}else{nextforest[i,j]<-0}},
               "1"={if(nine>30){nextforest[i,j]<-10}else{nextforest[i,j]<-1}},
               "10"={if(nine%%10>=1&nine>=20){nextforest[i,j]<-10}else{nextforest[i,j]<-0}},
               cat("something is wrong\n"))
                #cat(i,j,lsc[i,j], nine,nextforest[i,j],"\n")
                }}
    lsc<-nextforest
    
  cel<-melt(lsc)
  cel<-cbind(cel,rep(r,nrow(cel)))
    names(cel)<-c("y","x","resources","minutes")

      anim<-rbind(anim,cel)
    r<-r+1}
  trees<-length(which(lsc==1))
  lumberyards<-length(which(lsc==10))
  resources<-trees*lumberyards
  anim}
mkgraph<-forestgrowanimation(landscape,599)
mkgraph$resources<-as.character(mkgraph$resources)

resourcecolors<-c("0"="#6F4E37","10"="#999999","1"="#00AA00")
lumberfield<-ggplot()+
  scale_fill_manual(values=resourcecolors)+
  geom_tile(data=mkgraph,aes(x=x,y=y,fill=resources))+
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.title.y = element_blank(),
        axis.title.x = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        legend.position="none")+
  scale_y_reverse()+
  coord_fixed()+
  transition_states(minutes,wrap=FALSE)

treegrowth<-animate(lumberfield,nframes=600,renderer = gifski_renderer())
treegrowth
Yes, there’s a pattern
Yes, there’s a pattern

Which looks like it begins repeating after a while - to figure out how often, looking for the minimums -

lowestpoints<-c(FALSE,sapply(2:999,function(x){if(first1000[x]<first1000[x-1]&&first1000[x]<first1000[x+1]){TRUE}else{FALSE}}),FALSE)
first1000[lowestpoints]

It looks like a repeat at 163430

which(first1000==163430)

This shows that the repeat is every 28 - shown again here:

diff(first1000[400:500],28)

So by repeat 500, this is on a 28 minute cycle

Which means that if it goes to 1000000000%%28+560 (560 is high enough and as a multiple of 28 will be basically a “reset”)

1000000000%%28+560
p2<-forestgrow(landscape,(1000000000%%28+560))
part2<-p2[[3]]
part2
LS0tDQp0aXRsZTogIkRheSAxOCBOb3RlYm9vayINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQ0KbGlicmFyeShnZ2FuaW1hdGUpDQpsaWJyYXJ5KGdpZnNraSkNCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkocmVzaGFwZTIpDQpsaWJyYXJ5KGtuaXRyKQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkoc3RyaW5ncikNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShyZWFkcikNCmxpYnJhcnkoY29sbGVjdGlvbnMpDQpvcHRpb25zKHNjaXBlbiA9IDk5OSkNCmBgYA0KDQpgYGB7cn0NCiNpbnB1dDwtcmVhZF9saW5lcygiRGF5MThTYW1wbGUudHh0IikNCmlucHV0PC1yZWFkX2xpbmVzKCIuLi8uLi9Bb0NEYXRhL0FPQzIwMTgvRGF5MTgudHh0IikNCiMjIyBNYXRyaXgNCmxhbmRzY2FwZTwtbWF0cml4KDAsbnJvdz1sZW5ndGgoaW5wdXQpKzIsbmNvbD1uY2hhcihpbnB1dFsxXSkrMikNCg0KbHNjPC1sYXBwbHkoaW5wdXQsZnVuY3Rpb24oeCl7DQp4PC11bmxpc3Qoc3RyX3NwbGl0KHgsIiIpKQ0KeFt3aGljaCh4PT0iLiIpXTwtIjAiDQp4W3doaWNoKHg9PSJ8IildPC0iMSINCnhbd2hpY2goeD09IiMiKV08LSIxMCINCng8LWFzLm51bWVyaWMoeCl9KQ0KDQpmb3IoaSBpbiAxOmxlbmd0aChsc2MpKXtsYW5kc2NhcGVbaSsxLF08LWMoMCx1bmxpc3QobHNjW1tpXV0pLDApfQ0KYGBgDQojIyBQYXJ0IDENCg0KYGBge3J9DQpmb3Jlc3Rncm93PC1mdW5jdGlvbihsc2MscmVwcyl7DQogIHI8LTENCiAgd2hpbGUocjw9cmVwcyl7DQogICAgbmV4dGZvcmVzdDwtbWF0cml4KE5BLG5jb2w9bmNvbChsc2MpLG5yb3c9bnJvdyhsc2MpKQ0KICAgIG5leHRmb3Jlc3RbMSxdPC0wDQogICAgbmV4dGZvcmVzdFtucm93KG5leHRmb3Jlc3QpLF08LTANCiAgICBuZXh0Zm9yZXN0WywxXTwtMA0KICAgIG5leHRmb3Jlc3RbLG5jb2wobmV4dGZvcmVzdCldPC0wDQogICAgZm9yKGkgaW4gMjoobnJvdyhsc2MpLTEpKXsNCiAgICAgIGZvcihqIGluIDI6KG5jb2wobHNjKS0xKSl7DQogICAgICAgIG5pbmU8LXN1bShsc2NbKGktMSk6KGkrMSksKGotMSk6KGorMSldKQ0KICAgICAgICBzd2l0Y2goYXMuY2hhcmFjdGVyKGxzY1tpLGpdKSwNCiAgICAgICAgICAgICAgICIwIj17aWYobmluZSUlMTA+PTMpe25leHRmb3Jlc3RbaSxqXTwtMX1lbHNle25leHRmb3Jlc3RbaSxqXTwtMH19LA0KICAgICAgICAgICAgICAgIjEiPXtpZihuaW5lPjMwKXtuZXh0Zm9yZXN0W2ksal08LTEwfWVsc2V7bmV4dGZvcmVzdFtpLGpdPC0xfX0sDQogICAgICAgICAgICAgICAiMTAiPXtpZihuaW5lJSUxMD49MSZuaW5lPj0yMCl7bmV4dGZvcmVzdFtpLGpdPC0xMH1lbHNle25leHRmb3Jlc3RbaSxqXTwtMH19LA0KICAgICAgICAgICAgICAgY2F0KCJzb21ldGhpbmcgaXMgd3JvbmdcbiIpKQ0KICAgICAgICAgICAgICAgICNjYXQoaSxqLGxzY1tpLGpdLCBuaW5lLG5leHRmb3Jlc3RbaSxqXSwiXG4iKQ0KICAgICAgICAgICAgICAgIH19DQogICAgbHNjPC1uZXh0Zm9yZXN0DQogICAgcjwtcisxfQ0KICB0cmVlczwtbGVuZ3RoKHdoaWNoKGxzYz09MSkpDQogIGx1bWJlcnlhcmRzPC1sZW5ndGgod2hpY2gobHNjPT0xMCkpDQogIHJlc291cmNlczwtdHJlZXMqbHVtYmVyeWFyZHMNCiAgbGlzdCh0cmVlcyxsdW1iZXJ5YXJkcyxyZXNvdXJjZXMsbHNjKX0NCmBgYA0KDQoNCmBgYHtyfQ0KcDE8LWZvcmVzdGdyb3cobGFuZHNjYXBlLDEwKQ0KcGFydDE8LXAxW1szXV0NCnBhcnQxDQpgYGANCiMjIFBhcnQgMg0KDQpEZXBlbmRzIGhlYXZpbHkgb24gdGhlIGRhdGEsIHRoZSByZWFsIGRhdGEgaGFzIHRoZSBwYXR0ZXJuIGJlbG93DQpTdGFydCBieSBncmFwaGluZyB0byBzZWUgaWYgdGhlcmUncyBhIHBhdHRlcm4gZm9yIHNvbWV0aGluZyB0aGF0IGxvb2tzIGxpa2UgYSBwYXR0ZXJuIC0gDQoNCmBgYHtyLGV2YWw9RkFMU0V9DQpmb3Jlc3Rncm93YW5pbWF0aW9uPC1mdW5jdGlvbihsc2MscmVwcyl7DQogIHI8LTENCiAgYW5pbTwtYXMuZGF0YS5mcmFtZShtYXRyaXgobmNvbD00LG5yb3c9MCkpDQogIGNlbDwtbWVsdChsc2MpDQogIGNlbDwtY2JpbmQoY2VsLHJlcCgwLG5yb3coY2VsKSkpDQogIG5hbWVzKGNlbCk8LWMoInkiLCJ4IiwicmVzb3VyY2VzIiwibWludXRlcyIpDQogIGFuaW08LXJiaW5kKGFuaW0sY2VsKQ0KICBuYW1lcyhjZWwpPC1jKCJ5IiwieCIsInJlc291cmNlcyIsIm1pbnV0ZXMiKQ0KDQogIHdoaWxlKHI8PXJlcHMpew0KICAgIG5leHRmb3Jlc3Q8LW1hdHJpeChOQSxuY29sPW5jb2wobHNjKSxucm93PW5yb3cobHNjKSkNCiAgICBuZXh0Zm9yZXN0WzEsXTwtMA0KICAgIG5leHRmb3Jlc3RbbnJvdyhuZXh0Zm9yZXN0KSxdPC0wDQogICAgbmV4dGZvcmVzdFssMV08LTANCiAgICBuZXh0Zm9yZXN0WyxuY29sKG5leHRmb3Jlc3QpXTwtMA0KICAgIGZvcihpIGluIDI6KG5yb3cobHNjKS0xKSl7DQogICAgICBmb3IoaiBpbiAyOihuY29sKGxzYyktMSkpew0KICAgICAgICBuaW5lPC1zdW0obHNjWyhpLTEpOihpKzEpLChqLTEpOihqKzEpXSkNCiAgICAgICAgc3dpdGNoKGFzLmNoYXJhY3Rlcihsc2NbaSxqXSksDQogICAgICAgICAgICAgICAiMCI9e2lmKG5pbmUlJTEwPj0zKXtuZXh0Zm9yZXN0W2ksal08LTF9ZWxzZXtuZXh0Zm9yZXN0W2ksal08LTB9fSwNCiAgICAgICAgICAgICAgICIxIj17aWYobmluZT4zMCl7bmV4dGZvcmVzdFtpLGpdPC0xMH1lbHNle25leHRmb3Jlc3RbaSxqXTwtMX19LA0KICAgICAgICAgICAgICAgIjEwIj17aWYobmluZSUlMTA+PTEmbmluZT49MjApe25leHRmb3Jlc3RbaSxqXTwtMTB9ZWxzZXtuZXh0Zm9yZXN0W2ksal08LTB9fSwNCiAgICAgICAgICAgICAgIGNhdCgic29tZXRoaW5nIGlzIHdyb25nXG4iKSkNCiAgICAgICAgICAgICAgICAjY2F0KGksaixsc2NbaSxqXSwgbmluZSxuZXh0Zm9yZXN0W2ksal0sIlxuIikNCiAgICAgICAgICAgICAgICB9fQ0KICAgIGxzYzwtbmV4dGZvcmVzdA0KICAgIA0KICBjZWw8LW1lbHQobHNjKQ0KICBjZWw8LWNiaW5kKGNlbCxyZXAocixucm93KGNlbCkpKQ0KICAgIG5hbWVzKGNlbCk8LWMoInkiLCJ4IiwicmVzb3VyY2VzIiwibWludXRlcyIpDQoNCiAgICAgIGFuaW08LXJiaW5kKGFuaW0sY2VsKQ0KICAgIHI8LXIrMX0NCiAgdHJlZXM8LWxlbmd0aCh3aGljaChsc2M9PTEpKQ0KICBsdW1iZXJ5YXJkczwtbGVuZ3RoKHdoaWNoKGxzYz09MTApKQ0KICByZXNvdXJjZXM8LXRyZWVzKmx1bWJlcnlhcmRzDQogIGFuaW19DQpta2dyYXBoPC1mb3Jlc3Rncm93YW5pbWF0aW9uKGxhbmRzY2FwZSw1OTkpDQpta2dyYXBoJHJlc291cmNlczwtYXMuY2hhcmFjdGVyKG1rZ3JhcGgkcmVzb3VyY2VzKQ0KDQpyZXNvdXJjZWNvbG9yczwtYygiMCI9IiM2RjRFMzciLCIxMCI9IiM5OTk5OTkiLCIxIj0iIzAwQUEwMCIpDQpsdW1iZXJmaWVsZDwtZ2dwbG90KCkrDQogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcz1yZXNvdXJjZWNvbG9ycykrDQogIGdlb21fdGlsZShkYXRhPW1rZ3JhcGgsYWVzKHg9eCx5PXksZmlsbD1yZXNvdXJjZXMpKSsNCiAgdGhlbWUoYXhpcy50ZXh0LnggPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIGF4aXMudGlja3MueCA9IGVsZW1lbnRfYmxhbmsoKSwNCiAgICAgICAgYXhpcy50ZXh0LnkgPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIGF4aXMudGlja3MueSA9IGVsZW1lbnRfYmxhbmsoKSwNCiAgICAgICAgYXhpcy50aXRsZS55ID0gZWxlbWVudF9ibGFuaygpLA0KICAgICAgICBheGlzLnRpdGxlLnggPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIHBhbmVsLmdyaWQubWFqb3IgPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIHBhbmVsLmdyaWQubWlub3IgPSBlbGVtZW50X2JsYW5rKCksDQogICAgICAgIGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIpKw0KICBzY2FsZV95X3JldmVyc2UoKSsNCiAgY29vcmRfZml4ZWQoKSsNCiAgdHJhbnNpdGlvbl9zdGF0ZXMobWludXRlcyx3cmFwPUZBTFNFKQ0KDQp0cmVlZ3Jvd3RoPC1hbmltYXRlKGx1bWJlcmZpZWxkLG5mcmFtZXM9NjAwLHJlbmRlcmVyID0gZ2lmc2tpX3JlbmRlcmVyKCkpDQp0cmVlZ3Jvd3RoDQpgYGANCg0KIVtZZXMsIHRoZXJlJ3MgYSBwYXR0ZXJuXShkYXkxOC5naWYpDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQpXaGljaCBsb29rcyBsaWtlIGl0IGJlZ2lucyByZXBlYXRpbmcgYWZ0ZXIgYSB3aGlsZSAtIHRvIGZpZ3VyZSBvdXQgaG93IG9mdGVuLCBsb29raW5nIGZvciB0aGUgbWluaW11bXMgLSANCg0KYGBge3IsZXZhbD1GQUxTRX0NCmxvd2VzdHBvaW50czwtYyhGQUxTRSxzYXBwbHkoMjo5OTksZnVuY3Rpb24oeCl7aWYoZmlyc3QxMDAwW3hdPGZpcnN0MTAwMFt4LTFdJiZmaXJzdDEwMDBbeF08Zmlyc3QxMDAwW3grMV0pe1RSVUV9ZWxzZXtGQUxTRX19KSxGQUxTRSkNCmZpcnN0MTAwMFtsb3dlc3Rwb2ludHNdDQpgYGANCkl0IGxvb2tzIGxpa2UgYSByZXBlYXQgYXQgMTYzNDMwDQpgYGB7cixldmFsPUZBTFNFfQ0Kd2hpY2goZmlyc3QxMDAwPT0xNjM0MzApDQpgYGANClRoaXMgc2hvd3MgdGhhdCB0aGUgcmVwZWF0IGlzIGV2ZXJ5IDI4IC0gc2hvd24gYWdhaW4gaGVyZToNCmBgYHtyLGV2YWw9RkFMU0V9DQpkaWZmKGZpcnN0MTAwMFs0MDA6NTAwXSwyOCkNCmBgYA0KU28gYnkgcmVwZWF0IDUwMCwgdGhpcyBpcyBvbiBhIDI4IG1pbnV0ZSBjeWNsZQ0KDQpXaGljaCBtZWFucyB0aGF0IGlmIGl0IGdvZXMgdG8gMTAwMDAwMDAwMCUlMjgrNTYwICg1NjAgaXMgaGlnaCBlbm91Z2ggYW5kIGFzIGEgbXVsdGlwbGUgb2YgMjggd2lsbCBiZSBiYXNpY2FsbHkgYSAicmVzZXQiKQ0KDQpgYGB7cixldmFsPUZBTFNFfQ0KMTAwMDAwMDAwMCUlMjgrNTYwDQpgYGANCg0KYGBge3IsZXZhbD1GQUxTRX0NCnAyPC1mb3Jlc3Rncm93KGxhbmRzY2FwZSwoMTAwMDAwMDAwMCUlMjgrNTYwKSkNCnBhcnQyPC1wMltbM11dDQpwYXJ0Mg0KYGBg